home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / ParcElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-11-22  |  22.8 KB  |  529 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE ParcElems;    (** CAS/MH/HM 12.10.1993 **)
  5.     IMPORT
  6.         SYSTEM, Input, Display, Files, Oberon, Fonts, Texts, TextFrames, TextPrinter;
  7.     CONST
  8.         (**StateMsg.id*)
  9.             set* = 0; get* = 1;
  10.         mm = TextFrames.mm; unit = TextFrames.Unit; Unit = TextPrinter.Unit;
  11.         Scale = mm DIV 10; MinTabDelta = 2*mm; ParcHeight = 3*mm; ColumnGap = 7*mm;
  12.         gridAdj = TextFrames.gridAdj; leftAdj = TextFrames.leftAdj; rightAdj = TextFrames.rightAdj;
  13.         pageBreak = TextFrames.pageBreak;
  14.         twoColumns = TextFrames.twoColumns;
  15.         AdjMask = {leftAdj, rightAdj};
  16.         rightKey = 0; middleKey = 1; leftKey = 2; cancel = {rightKey, middleKey, leftKey};
  17.     TYPE
  18.         StateMsg* = RECORD (Texts.ElemMsg)
  19.             id*: INTEGER;
  20.             pos*: LONGINT;
  21.             frame*: TextFrames.Frame;
  22.             par*: Texts.Scanner;
  23.             log*: Texts.Text
  24.         END;
  25.         W: Texts.Writer;
  26.     PROCEDURE FlipBits(s: SET): SET;        (* << MB *)
  27.         VAR d: SET; i: INTEGER;
  28.     BEGIN
  29.         d := {}; i := 0;
  30.         WHILE i < 32 DO
  31.             IF i IN s THEN INCL(d, 31-i) END;
  32.             INC(i)
  33.         END;
  34.         RETURN d
  35.     END FlipBits;
  36.     PROCEDURE RdSet (VAR r: Files.Rider; VAR s: SET);
  37.         VAR t: SET;
  38.     BEGIN Files.ReadNum(r, SYSTEM.VAL(LONGINT, t)); s := FlipBits(t)
  39.     END RdSet;
  40.     PROCEDURE WrtSet (VAR r: Files.Rider; s: SET);
  41.     BEGIN Files.WriteNum(r, SYSTEM.VAL(LONGINT, FlipBits(s)))
  42.     END WrtSet;
  43.     PROCEDURE Str (s: ARRAY OF CHAR);
  44.     BEGIN Texts.WriteString(W, s)
  45.     END Str;
  46.     PROCEDURE Int (n: LONGINT);
  47.     BEGIN Texts.Write(W, " "); Texts.WriteInt(W, n, 0)
  48.     END Int;
  49.     PROCEDURE Ln;
  50.     BEGIN Texts.WriteLn(W)
  51.     END Ln;
  52.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  53.     BEGIN
  54.         IF x < y THEN RETURN x ELSE RETURN y END
  55.     END Min;
  56.     PROCEDURE Max (x, y: LONGINT): LONGINT;
  57.     BEGIN
  58.         IF x > y THEN RETURN x ELSE RETURN y END
  59.     END Max;
  60.     PROCEDURE Matches (VAR S: Texts.Scanner; key: ARRAY OF CHAR): BOOLEAN;
  61.         VAR i: INTEGER;
  62.     BEGIN i := 0;
  63.         WHILE (S.s[i] # 0X) & (CAP(S.s[i]) = key[i]) DO INC(i) END;
  64.         RETURN (S.class = Texts.Name) & ((key[i] = 0X) OR (i >= 3)) & (S.s[i] = 0X)
  65.     END Matches;
  66.     PROCEDURE GetNextInt (VAR S: Texts.Scanner; lo, hi, def: LONGINT);    (*constrained int w/ default*)
  67.     BEGIN Texts.Scan(S);
  68.         IF Matches(S, "DEFAULT") THEN S.class := Texts.Int; S.i := def
  69.         ELSIF S.class = Texts.Int THEN
  70.             IF (S.i < lo) OR (S.i >= hi) THEN S.i := def END
  71.         END
  72.     END GetNextInt;
  73.     PROCEDURE Grid (x: LONGINT): LONGINT;
  74.     BEGIN RETURN x + (-x) MOD (1 * mm)
  75.     END Grid;
  76.     PROCEDURE DrawCursor (x, y: INTEGER);
  77.     BEGIN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  78.     END DrawCursor;
  79.     PROCEDURE TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  80.     BEGIN Input.Mouse(keys, x, y); DrawCursor(x, y); keysum := keysum + keys
  81.     END TrackMouse;
  82.     PROCEDURE FlipZone (P: TextFrames.Parc; x0, y0, dw, dh, w: INTEGER);
  83.     BEGIN
  84.         IF dh < 4 THEN Display.ReplConst(Display.white, x0, y0, w, 4, Display.invert)
  85.         ELSIF (dh > 4) & (12 <= dw) & (dw < P.width DIV unit - 12) THEN
  86.             Display.ReplConst(Display.white, x0, y0 + 5, w, 4, Display.invert)
  87.         END
  88.     END FlipZone;
  89.     PROCEDURE FlipZone (P: TextFrames.Parc; x0, y0, dw, dh, w: INTEGER);
  90.         VAR pl, pf, pw: INTEGER;
  91.     BEGIN pl := SHORT(P.left DIV unit); pf := SHORT(P.first DIV unit); pw := SHORT(P.width DIV unit);
  92.         IF dh < 4 THEN Display.ReplConst(Display.white, x0, y0, w, 4, Display.invert)
  93.         ELSIF (dh > 4) & (pf # 0) & (pf <= dw) & (dw < pf + 4) THEN
  94.             Display.ReplConst(Display.white, x0 - pl, y0 + 5, w + pl, 4, Display.invert)
  95.         ELSIF (dh > 4) & (12 <= dw) & (dw < pw - 12) THEN
  96.             Display.ReplConst(Display.white, x0, y0 + 5, w, 4, Display.invert)
  97.         END
  98.     END FlipZone;
  99.     PROCEDURE FirstMark (col: SHORTINT; x, y0: INTEGER);
  100.     BEGIN Display.ReplConst(col, x, y0 + 5, 3, 4, Display.replace)
  101.     END FirstMark;
  102.     PROCEDURE AdjMark (F: Display.Frame; col: SHORTINT; x, y0: INTEGER);
  103.     BEGIN Display.ReplPatternC(F, col, Display.grey1, x, y0 + 6, 11, 3, x, y0 + 5, Display.replace)
  104.     END AdjMark;
  105.     PROCEDURE FlipFirst (P: TextFrames.Parc; x0, y0: INTEGER);
  106.     BEGIN Display.ReplConst(Display.white, x0 + SHORT((P.left + P.first) DIV unit), y0 + 5, 3, 4, Display.invert)
  107.     END FlipFirst;
  108.     PROCEDURE MoveFirst (P: TextFrames.Parc; x0, y0, dw: INTEGER);
  109.         VAR px: LONGINT;
  110.     BEGIN px := Grid(LONG(dw) * unit);
  111.         IF (px # P.first) & (-P.left <= px) & (px < P.width) THEN
  112.             FlipFirst(P, x0, y0); P.first := px; FlipFirst(P, x0, y0)
  113.         END
  114.     END MoveFirst;
  115.     PROCEDURE FlipLeft (P: TextFrames.Parc; x0, y0: INTEGER);
  116.     BEGIN Display.ReplConst(Display.white, x0 + SHORT(P.left DIV unit), y0 + 4, 12, 5, Display.invert)
  117.     END FlipLeft;
  118.     PROCEDURE MoveLeft (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  119.         VAR px: LONGINT;
  120.     BEGIN px := Grid(LONG(dw) * unit);
  121.         IF (px # P.left) & (0 <= px) & (px < rm) THEN FlipLeft(P, x0, y0); P.left := px; FlipLeft(P, x0, y0) END
  122.     END MoveLeft;
  123.     PROCEDURE FlipRight (P: TextFrames.Parc; x0, y0: INTEGER);
  124.     BEGIN Display.ReplConst(Display.white, x0 + SHORT((P.left + P.width) DIV unit) - 12, y0 + 4, 12, 5, Display.invert)
  125.     END FlipRight;
  126.     PROCEDURE MoveRight (P: TextFrames.Parc; rm: LONGINT; x0, y0, dw: INTEGER);
  127.         VAR px: LONGINT;
  128.     BEGIN px := Grid(LONG(dw) * unit);
  129.         IF (px # P.left + P.width) & (P.left + 10*mm <= px) & (px < rm) THEN
  130.             FlipRight(P, x0, y0); P.width := px - P.left; FlipRight(P, x0, y0)
  131.         END
  132.     END MoveRight;
  133.     PROCEDURE TabMark (col: SHORTINT; x, y: INTEGER);
  134.     BEGIN Display.ReplConst(col, x, y + 1, 2, 3, Display.replace)
  135.     END TabMark;
  136.     PROCEDURE FlipTab (P: TextFrames.Parc; i, x0, y0: INTEGER);
  137.     BEGIN Display.ReplConst(Display.white, x0 + SHORT(P.tab[i] DIV unit), y0 + 1, 2, 3, Display.invert)
  138.     END FlipTab;
  139.     PROCEDURE GrabTab (P: TextFrames.Parc; x0, y0, dw: INTEGER; VAR i: INTEGER; VAR new: BOOLEAN);
  140.         VAR j: INTEGER; lx, px, rx: LONGINT;
  141.     BEGIN
  142.         i := 0; j := P.nofTabs; new := FALSE; px := Grid(LONG(dw) * unit);
  143.         WHILE (i < j) & (P.tab[i] < px - 1*mm) DO INC(i) END;
  144.         IF i < TextFrames.MaxTabs THEN
  145.             IF (i = j) OR (P.tab[i] >= px + 1*mm) THEN
  146.                 IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  147.                 IF i = P.nofTabs THEN rx := P.width ELSE rx := P.tab[i] - MinTabDelta END;
  148.                 IF px < lx THEN px := lx END;
  149.                 IF px < rx THEN INC(P.nofTabs); new := TRUE;
  150.                     WHILE j > i DO P.tab[j] := P.tab[j - 1]; DEC(j) END
  151.                 END
  152.             ELSE px := P.tab[i]
  153.             END
  154.         ELSE DEC(i); px := P.tab[i]
  155.         END;
  156.         IF ~new THEN FlipTab(P, i, x0, y0) END;
  157.         P.tab[i] := px; FlipTab(P, i, x0, y0)
  158.     END GrabTab;
  159.     PROCEDURE MoveTab (P: TextFrames.Parc; rm: LONGINT; i, x0, y0, dw: INTEGER);
  160.         VAR lx, px, rx: LONGINT;
  161.     BEGIN px := Grid(LONG(dw) * unit);
  162.         IF i = 0 THEN lx := MinTabDelta ELSE lx := P.tab[i - 1] + MinTabDelta END;
  163.         IF i = P.nofTabs - 1 THEN rx := P.width ELSE rx := P.tab[i + 1] - MinTabDelta END;
  164.         IF (px # P.tab[i]) & (lx <= px) & (px <= rx) & (px <= rm) THEN
  165.             FlipTab(P, i, x0, y0); P.tab[i] := px; FlipTab(P, i, x0, y0)
  166.         END
  167.     END MoveTab;
  168.     PROCEDURE RemoveTab (P: TextFrames.Parc; i: INTEGER);
  169.     BEGIN
  170.         WHILE i < P.nofTabs - 1 DO P.tab[i] := P.tab[i + 1]; INC(i) END;
  171.         DEC(P.nofTabs)
  172.     END RemoveTab;
  173.     PROCEDURE Changed (E: Texts.Elem; beg: LONGINT);
  174.         VAR T: Texts.Text;
  175.     BEGIN T := Texts.ElemBase(E); Texts.ChangeLooks(T, beg, beg+1, {}, NIL, 0, 0)
  176.     END Changed;
  177.     PROCEDURE ParcExtent* (T: Texts.Text; beg: LONGINT; VAR end: LONGINT);
  178.         VAR R: Texts.Reader;
  179.     BEGIN Texts.OpenReader(R, T, beg + 1);
  180.         REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS TextFrames.Parc);
  181.         IF R.eot THEN end := T.len ELSE end := Texts.Pos(R) - 1 END
  182.     END ParcExtent;
  183.     PROCEDURE ChangedParc* (P: TextFrames.Parc; beg: LONGINT);
  184.         VAR T: Texts.Text; end: LONGINT;
  185.     BEGIN T := Texts.ElemBase(P); ParcExtent(T, beg, end); Texts.ChangeLooks(T, beg, end, {}, NIL, 0, 0)
  186.     END ChangedParc;
  187.     PROCEDURE LoadParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  188.         VAR version, i, j, k: LONGINT;
  189.     BEGIN Files.ReadNum(r, version);    (*version 1*)
  190.         Files.ReadNum(r, P.first); Files.ReadNum(r, P.left); Files.ReadNum(r, P.width);
  191.         Files.ReadNum(r, P.lead); Files.ReadNum(r, P.lsp); Files.ReadNum(r, P.dsr);
  192.         RdSet(r, P.opts); Files.ReadNum(r, i);
  193.         IF i <= TextFrames.MaxTabs THEN P.nofTabs := SHORT(i) ELSE P.nofTabs := TextFrames.MaxTabs END;
  194.         j := 0; WHILE j < P.nofTabs DO Files.ReadNum(r, P.tab[j]); INC(j) END;
  195.         WHILE j < i DO Files.ReadNum(r, k); INC(j) END;
  196.     END LoadParc;
  197.     PROCEDURE StoreParc* (P: TextFrames.Parc; VAR r: Files.Rider);
  198.         VAR i: INTEGER;
  199.     BEGIN Files.WriteNum(r, 1);    (*version 1*)
  200.         Files.WriteNum(r, P.first); Files.WriteNum(r, P.left); Files.WriteNum(r, P.width);
  201.         Files.WriteNum(r, P.lead); Files.WriteNum(r, P.lsp); Files.WriteNum(r, P.dsr);
  202.         WrtSet(r, P.opts); Files.WriteNum(r, P.nofTabs); i := 0;
  203.         WHILE i < P.nofTabs DO Files.WriteNum(r, P.tab[i]); INC(i) END
  204.     END StoreParc;
  205.     PROCEDURE CopyParc* (SP, DP: TextFrames.Parc);
  206.         VAR i: INTEGER;
  207.     BEGIN Texts.CopyElem(SP, DP);
  208.         DP.first := SP.first; DP.left := SP.left; DP.width := SP.width;
  209.         DP.lead := SP.lead; DP.lsp := SP.lsp; DP.dsr := SP.dsr;
  210.         DP.opts := SP.opts; DP.nofTabs := SP.nofTabs; i := SP.nofTabs;
  211.         WHILE i > 0 DO DEC(i); DP.tab[i] := SP.tab[i] END
  212.     END CopyParc;
  213.     PROCEDURE Prepare* (P: TextFrames.Parc; indent, unit: LONGINT);
  214.     BEGIN P.W := 9999 * unit; P.H := ParcHeight + P.lead;
  215.         IF gridAdj IN P.opts THEN INC(P.H, (-P.lead) MOD P.lsp) END
  216.     END Prepare;
  217.     PROCEDURE Draw* (P: TextFrames.Parc; F: Display.Frame; col: SHORTINT; x0, y0: INTEGER);
  218.         VAR i, x1, px, w, n: INTEGER;
  219.     BEGIN x1 := x0 + SHORT(P.left DIV unit); w := SHORT((P.W - P.left) DIV unit);
  220.         IF twoColumns IN P.opts THEN n := 2 ELSE n := 1 END;
  221.         WHILE n > 0 DO DEC(n);
  222.             IF w > 20 THEN i := 0;
  223.                 LOOP
  224.                     IF i = P.nofTabs THEN EXIT END;
  225.                     px := SHORT(x1 + P.tab[i] DIV unit);
  226.                     IF px > x1 + w THEN EXIT END;
  227.                     TabMark(col, px, y0); INC(i)
  228.                 END;
  229.                 IF pageBreak IN P.opts THEN Display.ReplConst(col, x1, y0 + 4, w, 1, Display.replace)
  230.                 ELSE Display.ReplPatternC(F, col, Display.grey1, x1, y0 + 4, w, 1, x1, y0 + 4, Display.replace)
  231.                 END;
  232.                 IF leftAdj IN P.opts THEN AdjMark(F, col, x1, y0) END;
  233.                 IF rightAdj IN P.opts THEN AdjMark(F, col, x1 + w - 11, y0) END;
  234.                 IF P.opts * AdjMask = {} THEN AdjMark(F, col, x1 + w DIV 2 - 5, y0) END;
  235.                 IF P.first # 0 THEN FirstMark(col, x0 + SHORT((P.left + P.first) DIV unit), y0) END;
  236.                 WITH F: TextFrames.Frame DO    (*recalc base measures for second column*)
  237.                     x0 := SHORT(Max( x1 + w + ColumnGap DIV unit, x0 + (F.W - F.left - F.right + ColumnGap DIV unit) DIV 2 ));
  238.                     x1 := x0 + SHORT(P.left DIV unit);
  239.                     w := SHORT(Min( (F.X + F.W - F.right) - x1, (P.W - P.left) DIV unit ))
  240.                 END
  241.             END
  242.         END
  243.     END Draw;
  244.     PROCEDURE Edit* (P: TextFrames.Parc; F: TextFrames.Frame; pos: LONGINT; x0, y0, x, y : INTEGER; keysum: SET);
  245.         VAR keys: SET; old, rx: LONGINT; i, x1, dw, dh, dx, w, h: INTEGER; changed, new: BOOLEAN;
  246.     BEGIN
  247.         IF (middleKey IN keysum) & F.showsParcs THEN changed := FALSE;
  248.             x1 := x0 + SHORT(P.left DIV unit); w := SHORT((P.W - P.left) DIV unit); h := SHORT(P.H DIV unit);
  249.             dh := y - y0; dw := x - x1;
  250.             Oberon.RemoveMarks(x0, y0, SHORT(P.W DIV unit), h); FlipZone(P, x1, y0, dw, dh, w);
  251.             IF (dw >= 0) & (dh < 4) THEN
  252.                 IF dw > 0 THEN changed := TRUE; GrabTab(P, x1, y0, x - x1, i, new); old := P.tab[i];
  253.                     rx := LONG(F.W - F.left - F.right) * unit - P.left; dx := dw - SHORT(old DIV unit);
  254.                     REPEAT TrackMouse(x, y, keys, keysum); MoveTab(P, rx, i, x1, y0, (x - x1) - dx) UNTIL keys = {};
  255.                     IF keysum = {middleKey} THEN FlipTab(P, i, x1, y0)
  256.                     ELSIF keysum = {middleKey, rightKey} THEN FlipTab(P, i, x1, y0); rx := P.tab[i] - old;
  257.                         WHILE i < P.nofTabs-1 DO INC(i); INC(P.tab[i], rx) END
  258.                     ELSIF new OR (keysum = {middleKey, leftKey}) THEN RemoveTab(P, i)
  259.                     ELSE changed := FALSE; FlipTab(P, i, x1, y0); P.tab[i] := old; FlipTab(P, i, x1, y0)
  260.                     END
  261.                 END
  262.             ELSIF (P.first # 0) & (P.first DIV unit <= dw) & (dw < P.first DIV unit + 4) & (dh > 4) THEN
  263.                 old := P.first; dx := dw - SHORT(P.first DIV unit);
  264.                 REPEAT TrackMouse(x, y, keys, keysum); MoveFirst(P, x0, y0, (x - x1) - dx) UNTIL keys = {};
  265.                 IF keysum # cancel THEN changed := TRUE ELSE FlipFirst(P, x0, y0); P.first := old; FlipFirst(P, x0, y0) END
  266.             ELSIF (dw >= 0) & (dh > 4) THEN
  267.                 IF dw < 12 THEN
  268.                     IF P.left DIV unit < F.W - F.left - F.right THEN FlipLeft(P, x0, y0); old := P.left;
  269.                         rx := P.left + P.width - 10*mm;
  270.                         REPEAT TrackMouse(x, y, keys, keysum); MoveLeft(P, rx, x0, y0, (x - x0) - dw) UNTIL keys = {};
  271.                         IF keysum = {middleKey} THEN DEC(P.width, P.left - old); changed := TRUE
  272.                         ELSIF (keysum = {middleKey, rightKey}) & (P.width - 2*(P.left - old) >= 10*mm) THEN
  273.                             DEC(P.width, 2*(P.left - old)); changed := TRUE
  274.                         ELSIF keysum = {middleKey, leftKey} THEN P.first := P.left - old; P.left := old; changed := TRUE
  275.                         ELSE FlipLeft(P, x0, y0); P.left := old
  276.                         END;
  277.                         IF P.left + P.first < 0 THEN P.first := -P.left; changed := TRUE
  278.                         ELSIF P.left + P.first > P.left + P.width THEN P.first := P.width; changed := TRUE
  279.                         END
  280.                     END
  281.                 ELSIF dw >= P.width DIV unit - 12 THEN FlipRight(P, x0, y0); old := P.width;
  282.                     rx := LONG(F.W - F.left - F.right) * unit; dx := dw - SHORT(P.width DIV unit);
  283.                     REPEAT TrackMouse(x, y, keys, keysum); MoveRight(P, rx, x0, y0, (x - x0) - dx) UNTIL keys = {};
  284.                     IF keysum = {middleKey} THEN changed := TRUE
  285.                     ELSIF (keysum = {middleKey, rightKey})
  286.                     & (P.left + old - P.width >= 0) & (P.width - (old - P.width) >= 10*mm) THEN
  287.                         INC(P.left, old - P.width); DEC(P.width, old - P.width); changed := TRUE
  288.                     ELSE FlipRight(P, x0, y0); P.width := old
  289.                     END;
  290.                     IF P.left + P.first < 0 THEN P.first := -P.left; changed := TRUE
  291.                     ELSIF P.left + P.first > P.left + P.width THEN P.first := P.width; changed := TRUE
  292.                     END
  293.                 ELSE changed := TRUE;
  294.                     REPEAT TrackMouse(x, y, keys, keysum) UNTIL keys = {};
  295.                     IF keysum = {middleKey} THEN dw := x - x1;
  296.                         IF (dw < w DIV 3) & (P.opts * AdjMask # {leftAdj}) THEN P.opts := P.opts - AdjMask + {leftAdj}
  297.                         ELSIF (w DIV 3 <= dw) & (dw < 2 * w DIV 3) & (P.opts * AdjMask # {}) THEN
  298.                             P.opts := P.opts - AdjMask
  299.                         ELSIF (2 * w DIV 3 <= dw) & (P.opts * AdjMask # {rightAdj}) THEN
  300.                             P.opts := P.opts - AdjMask + {rightAdj}
  301.                         ELSE changed := FALSE
  302.                         END
  303.                     ELSIF (keysum = {middleKey, leftKey}) & (P.opts * AdjMask # AdjMask) THEN
  304.                         P.opts := P.opts + AdjMask
  305.                     ELSIF keysum = {middleKey, rightKey} THEN P.opts := P.opts / {twoColumns};
  306.                         IF twoColumns IN P.opts THEN P.width := (P.width - ColumnGap) DIV 2
  307.                         ELSE P.width := P.width * 2 + ColumnGap
  308.                         END
  309.                     ELSE changed := FALSE
  310.                     END
  311.                 END
  312.             END;
  313.             IF changed THEN ChangedParc(P, pos) ELSE FlipZone(P, x1, y0, dw, dh, w) END
  314.         END
  315.     END Edit;
  316.     PROCEDURE SetAttr* (P: TextFrames.Parc; F: TextFrames.Frame; pos: LONGINT;
  317.                                     VAR S: Texts.Scanner; log: Texts.Text);
  318.         VAR fnt: Fonts.Font; def, pt, lsp, dsr: LONGINT;
  319.         PROCEDURE SetMeasure (new: LONGINT; VAR old: LONGINT);
  320.         BEGIN
  321.             IF new # old THEN old := new; ChangedParc(P, pos) END
  322.         END SetMeasure;
  323.         PROCEDURE SetOpts (opts: SET);
  324.         BEGIN
  325.             IF P.opts #opts THEN P.opts := opts; ChangedParc(P, pos) END
  326.         END SetOpts;
  327.         PROCEDURE Err (s: ARRAY OF CHAR; n: INTEGER);
  328.         BEGIN Str("Set "); Str(s); Str(" failed (bad ");
  329.             CASE n OF
  330.                 0: Str("number)")
  331.             |  1: Str("indentation)")
  332.             |  2: Str("option)")
  333.             |  3: Str("selector)")
  334.             END;
  335.             Ln
  336.         END Err;
  337.     BEGIN
  338.         IF Matches(S, "LEAD") THEN def := TextFrames.defParc.lead DIV Scale;
  339.             GetNextInt(S, 0, 10000, def);
  340.             IF S.class = Texts.Int THEN SetMeasure(S.i * Scale, P.lead)
  341.             ELSIF S.class = Texts.Name THEN fnt := Fonts.This(S.s);
  342.                 lsp := Max(fnt.height, fnt.maxY - fnt.minY) * unit; INC(lsp, (-lsp) MOD Scale);
  343.                 SetMeasure(lsp, P.lead)
  344.             ELSE Err("lead", 0)
  345.             END
  346.         ELSIF Matches(S, "LINE") THEN def := TextFrames.defParc.lsp DIV Scale;
  347.             GetNextInt(S, 10, 10000, def);
  348.             IF S.class = Texts.Int THEN lsp := S.i * Scale; dsr := lsp DIV 4; INC(dsr, (-dsr) MOD Scale)
  349.             ELSIF S.class = Texts.Name THEN fnt := Fonts.This(S.s);
  350.                 lsp := Max(fnt.height, fnt.maxY - fnt.minY) * unit; INC(lsp, (-lsp) MOD Scale);
  351.                 dsr := LONG(-fnt.minY) * unit; INC(dsr, (-dsr) MOD Scale)
  352.             ELSE Err("line", 0); lsp := P.lsp; dsr := P.dsr
  353.             END;
  354.             IF (P.lsp # lsp) OR (P.dsr # dsr) THEN P.lsp := lsp; P.dsr := dsr; ChangedParc(P, pos) END
  355.         ELSIF Matches(S, "FIRST") THEN def := TextFrames.defParc.first DIV Scale;
  356.             GetNextInt(S, -10000, 10000, def);
  357.             IF S.class = Texts.Int THEN
  358.                 IF (0 <= P.left + S.i * Scale) & (P.left + S.i * Scale <= P.left + P.width) THEN SetMeasure(S.i * Scale, P.first)
  359.                 ELSE Err("first", 1)
  360.                 END
  361.             ELSE Err("first", 0)
  362.             END
  363.         ELSIF Matches(S, "LEFT") THEN def := TextFrames.defParc.left DIV Scale;
  364.             GetNextInt(S, 0, 10000, def);
  365.             IF S.class = Texts.Int THEN
  366.                 IF S.i * Scale # P.left THEN INC(P.width, P.left - S.i * Scale);
  367.                     P.left := S.i * Scale; ChangedParc(P, pos)
  368.                 END;
  369.             ELSE Err("left", 0)
  370.             END
  371.         ELSIF Matches(S, "RIGHT") THEN def := (TextFrames.defParc.left + TextFrames.defParc.width) DIV Scale;
  372.             GetNextInt(S, 0, 10000, def);
  373.             IF S.class = Texts.Int THEN SetMeasure(S.i * Scale - P.left, P.width)
  374.             ELSE Err("right", 0)
  375.             END
  376.         ELSIF Matches(S, "WIDTH") THEN def := TextFrames.defParc.width DIV Scale;
  377.             GetNextInt(S, 100, 10000, def);
  378.             IF S.class = Texts.Int THEN SetMeasure(S.i * Scale, P.width)
  379.             ELSE Err("width", 0)
  380.             END
  381.         ELSIF Matches(S, "GRID") THEN Texts.Scan(S);
  382.             IF Matches(S, "ON") THEN SetOpts(P.opts + {gridAdj})
  383.             ELSIF Matches(S, "OFF") THEN SetOpts(P.opts - {gridAdj})
  384.             ELSE Err("grid", 2)
  385.             END
  386.         ELSIF Matches(S, "ADJUST") THEN Texts.Scan(S);
  387.             IF Matches(S, "LEFT") THEN SetOpts(P.opts - AdjMask + {leftAdj})
  388.             ELSIF Matches(S, "RIGHT") THEN SetOpts(P.opts - AdjMask + {rightAdj})
  389.             ELSIF Matches(S, "CENTER") THEN SetOpts(P.opts - AdjMask)
  390.             ELSIF Matches(S, "BLOCK") THEN SetOpts(P.opts + AdjMask)
  391.             ELSE Err("adjust", 2)
  392.             END
  393.         ELSIF Matches(S, "BREAK") THEN Texts.Scan(S);
  394.             IF Matches(S, "BEFORE") THEN SetOpts(P.opts + {pageBreak})
  395.             ELSIF Matches(S, "NORMAL") THEN SetOpts(P.opts - {pageBreak})
  396.             ELSE Err("break", 2)
  397.             END
  398.         ELSIF Matches(S, "COLUMNS") THEN GetNextInt(S, 1, 3, 1);
  399.             IF S.class = Texts.Int THEN
  400.                 IF S.i = 1 THEN SetOpts(P.opts - {twoColumns})
  401.                 ELSE SetOpts(P.opts + {twoColumns})
  402.                 END
  403.             ELSE Err("left", 0)
  404.             END
  405.         ELSIF Matches(S, "TABS") THEN Texts.Scan(S); P.nofTabs := 0; pt := 0;
  406.             IF (S.class = Texts.Char) & (S.c = "*") THEN Texts.Scan(S);
  407.                 IF (S.class = Texts.Int) & (S.i * Scale >= MinTabDelta) THEN
  408.                     WHILE (P.nofTabs < TextFrames.MaxTabs) & (pt < 3000) DO
  409.                         INC(pt, S.i); P.tab[P.nofTabs] := pt * Scale; INC(P.nofTabs)
  410.                     END
  411.                 END
  412.             ELSE
  413.                 WHILE (S.class = Texts.Int) & (S.i * Scale >= pt * Scale + MinTabDelta)
  414.                 & (P.nofTabs < TextFrames.MaxTabs) DO
  415.                     pt := S.i; P.tab[P.nofTabs] := pt * Scale; INC(P.nofTabs); Texts.Scan(S)
  416.                 END
  417.             END;
  418.             ChangedParc(P, pos)
  419.         ELSE Err("", 3)
  420.         END;
  421.         IF W.buf.len # 0 THEN Texts.Append(log, W.buf) END
  422.     END SetAttr;
  423.     PROCEDURE GetAttr* (P: TextFrames.Parc; F: TextFrames.Frame; VAR S: Texts.Scanner; log: Texts.Text);
  424.         VAR n: INTEGER;
  425.         PROCEDURE Out (n: INTEGER);
  426.             VAR i: INTEGER; d: LONGINT;
  427.         BEGIN
  428.             CASE n OF
  429.                 0: Str("lead"); Int(P.lead DIV Scale)
  430.             |  1: Str("line"); Int(P.lsp DIV Scale)
  431.             |  2: Str("left"); Int(P.left DIV Scale)
  432.             |  3: Str("first"); Int(P.first DIV Scale)
  433.             |  4: Str("width"); Int(P.width DIV Scale)
  434.             |  5: Str("right"); Int((P.left + P.width) DIV Scale)
  435.             |  6: IF gridAdj IN P.opts THEN Str("grid on") ELSE Str("grid off") END
  436.             |  7:
  437.                     IF leftAdj IN P.opts THEN
  438.                         IF rightAdj IN P.opts THEN Str("adjust block") ELSE Str("adjust left") END
  439.                     ELSIF rightAdj IN P.opts THEN Str("adjust right")
  440.                     ELSE Str("adjust center")
  441.                     END
  442.             |  8: IF pageBreak IN P.opts THEN Str("break before") ELSE Str("break normal") END
  443.             |  9: IF twoColumns IN P.opts THEN Str("columns 2") ELSE Str("columns 1") END
  444.             | 10: Str("tabs"); i := 0;
  445.                     IF P.nofTabs > 0 THEN d := P.tab[0]; i := 1;
  446.                         WHILE (i < P.nofTabs) & (P.tab[i] - P.tab[i - 1] = d) DO INC(i) END
  447.                     END;
  448.                     IF (P.nofTabs > 1) & (i = P.nofTabs) & (P.tab[i - 1] + MinTabDelta > P.width) THEN
  449.                         Str(" *"); Int(d DIV Scale)
  450.                     ELSE i := 0;
  451.                         WHILE i < P.nofTabs DO Int(P.tab[i] DIV Scale); INC(i) END;
  452.                         Str(" ~")
  453.                     END
  454.             END
  455.         END Out;
  456.     BEGIN
  457.         IF S.class # Texts.Name THEN Out(0); n := 1;
  458.             REPEAT Ln; Out(n); INC(n) UNTIL n = 11
  459.         ELSIF Matches(S, "LEAD") THEN Out(0)
  460.         ELSIF Matches(S, "LINE") THEN Out(1)
  461.         ELSIF Matches(S, "LEFT") THEN Out(2)
  462.         ELSIF Matches(S, "FIRST") THEN Out(3)
  463.         ELSIF Matches(S, "WIDTH") THEN Out(4)
  464.         ELSIF Matches(S, "RIGHT") THEN Out(5)
  465.         ELSIF Matches(S, "GRID") THEN Out(6)
  466.         ELSIF Matches(S, "ADJUST") THEN Out(7)
  467.         ELSIF Matches(S, "BREAK") THEN Out(8)
  468.         ELSIF Matches(S, "COLUMNS") THEN Out(9)
  469.         ELSIF Matches(S, "TABS") THEN Out(10)
  470.         ELSE Str("failed (bad selector)")
  471.         END;
  472.         Texts.Append(log, W.buf)
  473.     END GetAttr;
  474.     PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  475.         VAR e: TextFrames.Parc;
  476.     BEGIN
  477.         WITH E: TextFrames.Parc DO
  478.             IF msg IS TextFrames.DisplayMsg THEN
  479.                 WITH msg: TextFrames.DisplayMsg DO
  480.                     IF msg.prepare THEN Prepare(E, msg.indent, unit)
  481.                     ELSE Draw(E, msg.frame, msg.col, msg.X0, msg.Y0)
  482.                     END
  483.                 END
  484.             ELSIF msg IS TextPrinter.PrintMsg THEN
  485.                 WITH msg: TextPrinter.PrintMsg DO
  486.                     IF msg.prepare THEN Prepare(E, msg.indent, Unit) END
  487.                 END
  488.             ELSIF msg IS Texts.CopyMsg THEN NEW(e); CopyParc(E, e); msg(Texts.CopyMsg).e := e
  489.             ELSIF msg IS TextFrames.TrackMsg THEN
  490.                 WITH msg: TextFrames.TrackMsg DO
  491.                     Edit(E, msg.frame(TextFrames.Frame), msg.pos, msg.X0, msg.Y0, msg.X, msg.Y, msg.keys)
  492.                 END
  493.             ELSIF msg IS Texts.IdentifyMsg THEN
  494.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "ParcElems"; msg.proc := "Alloc" END
  495.             ELSIF msg IS Texts.FileMsg THEN
  496.                 WITH msg: Texts.FileMsg DO
  497.                     IF msg.id = Texts.load THEN LoadParc(E, msg.r)
  498.                     ELSIF msg.id = Texts.store THEN StoreParc(E, msg.r)
  499.                     END
  500.                 END
  501.             ELSIF msg IS StateMsg THEN
  502.                 WITH msg: StateMsg DO
  503.                     IF msg.id = set THEN SetAttr(E, msg.frame, msg.pos, msg.par, msg.log)
  504.                     ELSIF msg.id = get THEN GetAttr(E, msg.frame, msg.par, msg.log)
  505.                     END
  506.                 END
  507.             END
  508.         END
  509.     END Handle;
  510.     PROCEDURE Alloc*;
  511.         VAR e: TextFrames.Parc;
  512.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  513.     END Alloc;
  514.     PROCEDURE InitDefParc (VAR def: TextFrames.Parc);
  515.         VAR h, lsp, dsr: LONGINT; i: INTEGER;
  516.     BEGIN
  517.         lsp := Max(Fonts.Default.height, Fonts.Default.maxY - Fonts.Default.minY) * unit;
  518.         dsr := LONG(-Fonts.Default.minY) * unit;
  519.         NEW(def); def.W := 99; def.H := ParcHeight; def.handle := Handle;
  520.         def.first := 0; def.left := 0; (*def.width := 165*mm;*)
  521.         def.width := Max(165*mm, ((Display.Width DIV 8 * 5) - TextFrames.left - TextFrames.right - 2) * LONG(unit));
  522.         def.lead := 0; def.lsp := lsp + (-lsp) MOD Scale; def.dsr := dsr + (-dsr) MOD Scale;
  523.         def.opts := {leftAdj}; def.nofTabs := 0
  524.     END InitDefParc;
  525. BEGIN
  526.     Texts.OpenWriter(W);
  527.     InitDefParc(TextFrames.defParc)
  528. END ParcElems.
  529.